extracredit

I ran out of shiny sites to host before doing this assignment.

library(tidyverse)

## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.0 ──

## ✓ ggplot2 3.3.3     ✓ purrr   0.3.4
## ✓ tibble  3.1.0     ✓ dplyr   1.0.4
## ✓ tidyr   1.1.2     ✓ stringr 1.4.0
## ✓ readr   1.4.0     ✓ forcats 0.5.1

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

library(vroom)
library(sf)

## Linking to GEOS 3.8.1, GDAL 3.1.4, PROJ 6.3.1

library(spdep)

## Loading required package: sp

## Loading required package: spData

## To access larger datasets in this package, install the spDataLarge
## package with: `install.packages('spDataLarge',
## repos='https://nowosad.github.io/drat/', type='source')`

library(plotly)

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

mtvars <- function(df){
  df %>%
  dplyr::select(STOP_LOCATION_BORO_NAME, SUSPECT_RACE_DESCRIPTION, SUSPECT_HEIGHT,
         MONTH2, DAY2, STOP_WAS_INITIATED, SUSPECT_REPORTED_AGE,
         SUSPECT_SEX, WEAPON_FOUND_FLAG, SUSPECT_WEIGHT,
         SUSPECT_BODY_BUILD_TYPE, YEAR2,
         OFFICER_IN_UNIFORM_FLAG, SUSPECTS_ACTIONS_CASING_FLAG, 
         SUSPECTS_ACTIONS_CONCEALED_POSSESSION_WEAPON_FLAG, SUSPECTS_ACTIONS_DECRIPTION_FLAG,
         SUSPECTS_ACTIONS_DRUG_TRANSACTIONS_FLAG,SUSPECTS_ACTIONS_IDENTIFY_CRIME_PATTERN_FLAG,
         SUSPECTS_ACTIONS_LOOKOUT_FLAG, SUSPECTS_ACTIONS_OTHER_FLAG, SUSPECTS_ACTIONS_PROXIMITY_TO_SCENE_FLAG,
         STOP_LOCATION_PRECINCT)
}

#vroom data
data17 <- mtvars(vroom("sqf-2017.csv"))

## Rows: 11,629
## Columns: 83
## Delimiter: ","
## chr  [78]: STOP_FRISK_TIME, MONTH2, DAY2, STOP_WAS_INITIATED, RECORD_STATUS_CODE, ISSUING_...
## dbl  [ 4]: STOP_FRISK_ID, YEAR2, OBSERVED_DURATION_MINUTES, STOP_DURATION_MINUTES
## date [ 1]: STOP_FRISK_DATE
## 
## Use `spec()` to retrieve the guessed column specification
## Pass a specification to the `col_types` argument to quiet this message

data18 <- mtvars(vroom("sqf-2018.csv"))

## Rows: 11,008
## Columns: 83
## Delimiter: ","
## chr [74]: STOP_FRISK_DATE, Stop Frisk Time, MONTH2, DAY2, STOP_WAS_INITIATED, RECORD_STATU...
## dbl [ 9]: STOP_FRISK_ID, YEAR2, ISSUING_OFFICER_COMMAND_CODE, SUPERVISING_OFFICER_COMMAND_...
## 
## Use `spec()` to retrieve the guessed column specification
## Pass a specification to the `col_types` argument to quiet this message

data19 <- mtvars(vroom("sqf-2019.csv"))

## Rows: 13,459
## Columns: 83
## Delimiter: ","
## chr [72]: STOP_FRISK_DATE, STOP_FRISK_TIME, MONTH2, DAY2, STOP_WAS_INITIATED, RECORD_STATU...
## dbl [11]: STOP_ID_ANONY, YEAR2, ISSUING_OFFICER_COMMAND_CODE, SUPERVISING_OFFICER_COMMAND_...
## 
## Use `spec()` to retrieve the guessed column specification
## Pass a specification to the `col_types` argument to quiet this message

# code to confirm column names are the same
# all(colnames(data17) == colnames(data18)) 
# all(colnames(data17) == colnames(data19))

#bind data
mydata <- rbind(data17, data18, data19) 

## Warning: One or more parsing issues, see `problems()` for details

## Warning: One or more parsing issues, see `problems()` for details

nyp <- st_read("nypp.shx", quiet = T)

nyp <- rename(nyp, precinct = Precinct)

dat_sf <- mydata %>%
  rename(year = YEAR2, 
         precinct = STOP_LOCATION_PRECINCT) %>%
  mutate(precinct = as.numeric(precinct)) %>%
  group_by(year, precinct) %>%
  count() %>%
  right_join(nyp) %>%
  st_as_sf() %>%
  mutate(txt = paste("Precinct ", precinct, "\n", n, "SQF Events"))

## Warning in mask$eval_all_mutate(quo): NAs introduced by coercion

## Joining, by = "precinct"

p <- ggplot(dat_sf, aes(fill = (n), frame = year, text = txt)) + 
    geom_sf() + 
    scale_fill_viridis_c(option="A") +
    ggtitle("SQF Events in NY over time") +
    ggthemes::theme_map()

gg <- p %>%
  ggplotly(tooltip = "text") %>%
  style(hoveron = "fill") %>%
  plotly_build()

gg$x$frames <- lapply(
  gg$x$frames, function(f) { 
    f$data <- lapply(f$data, function(d) d[!names(d) %in% c("x", "y")])
    f 
  })

gg